home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE12 / WPTOOLS / WPTOOLS1.ZIP / DEMO / FastText / unit1.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-07-04  |  6.6 KB  |  238 lines
  1. unit Unit1;
  2.  
  3. interface    
  4.  
  5. {$IFDEF WIN32}      
  6. uses
  7.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  8.   WpWinCtr, WPRich, WPRuler, ExtCtrls, WPTbar, StdCtrls, WPPrTab1, WPTxtDef,
  9.   Buttons, WPDefs, WPStatus, Wpstat2, Unit2;
  10. {$ELSE}
  11. uses
  12.   WinProcs, WinTypes, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  13.   WpWinCtr, WPRich, WPRuler, ExtCtrls, WPTbar, StdCtrls, WPPrTab1, WPTxtDef,
  14.   Buttons, WPDefs, WPStatus, Wpstat2, Unit2;
  15. {$ENDIF}
  16.  
  17. type
  18.   TForm1 = class(TForm)
  19.     WPRichText1: TWPRichText;
  20.     Panel1: TPanel;
  21.     Textlines: TButton;
  22.     Table1: TButton;
  23.     StatusBar: TWPAltStatusBar;
  24.     Bevel1: TBevel;
  25.     AddGraphic: TButton;
  26.     Image1: TImage;
  27.     OpenDialog1: TOpenDialog;
  28.     Label1: TLabel;
  29.     Label2: TLabel;
  30.     procedure Button3Click(Sender: TObject);
  31.     procedure TextlinesClick(Sender: TObject);
  32.     procedure Table1Click(Sender: TObject);
  33.     procedure AddGraphicClick(Sender: TObject);
  34.     procedure Image1Click(Sender: TObject);
  35.   private
  36.     { Private-Deklarationen }
  37.     TransBuf : array[0..256] of Char;
  38.     PicLoaded   : Boolean;
  39.   public
  40.     { Public-Deklarationen }
  41.     FSpeedMerge : Boolean;
  42.     FTotal      : Longint;
  43.     FInpCount   : Integer;
  44.     procedure OnImageClick(var Sender: TObject;
  45.            x,y                 : Integer;  { Mouse position }
  46.            Tag, AutomaticTag   : Word;     { id in the text }
  47.            var w_twips,h_twips : Longint;   { size of box    }
  48.            var changed : Boolean);
  49.   end;
  50.  
  51. var
  52.   Form1: TForm1;    
  53.                   
  54. const
  55.   ObjTag = 1;
  56.   { Width and Height of the object in twips = 1/1440 inch.
  57.     When 0 the original value is used }
  58.   twWidthDefault  = 0;
  59.   twHeightDefault = 0;
  60.  
  61. implementation
  62.  
  63. {$R *.DFM}
  64.  
  65. procedure TForm1.Button3Click(Sender: TObject);
  66. var
  67.   prp : TParProps;
  68.   Aprp : array[0..5] of TParProps;  { declared in unit WPtxtDef }
  69.   i   : Integer;
  70.   j,a   : Integer;
  71. begin
  72.   FillChar(Aprp[0],Sizeof(TParProps)*6,0);
  73.   for i:=0 to 5 do
  74.   begin
  75.     Aprp[i].Attr := WPRichText1.Attr;
  76.     Aprp[i].BorderType.LineType := [blEnabled,blBox];
  77.     Aprp[i].text := 'Cell ' + IntToStr(i);
  78.   end;
  79.  
  80.   include(Aprp[5].Attr.Style,afsIsInsertPoint);
  81.   Aprp[5].text := '#';
  82.  
  83.   FillChar(prp,Sizeof(TParProps),0);
  84.   prp.Attr := WPRichText1.Attr;
  85.   j := 0;
  86.  
  87.   WPRichText1.Clear;
  88.   try
  89.     for a:=0 to 10 do
  90.     begin
  91.        prp.Attr.Height := 20;
  92.        prp.Text := '';
  93.        WPRichText1.FastAddText(prp);
  94.        prp.Text := 'An now the data '+IntToStr(j)+' to '+IntToStr(j+100);
  95.        WPRichText1.FastAddText(prp);
  96.        prp.Text := '';
  97.        WPRichText1.FastAddText(prp);
  98.        for i:=1 to 100 do
  99.        begin
  100.         Aprp[5].Attr.tag := j;
  101.  
  102.         Aprp[0].Attr.Color := i mod 15;
  103.         Aprp[0].Text := 'Row ' + IntToStr(j);
  104.         WPRichText1.FastAddTable(6,@(Aprp[0]));
  105.         inc(j);
  106.        end;
  107.     end;
  108.   finally
  109.   WPRichText1.Refresh;
  110.   end;
  111. end;
  112.  
  113. procedure TForm1.TextlinesClick(Sender: TObject);
  114. var
  115.   prp : TParProps;  { declared in unit WPtxtDef }
  116.   i   : Integer;
  117. begin
  118.   StatusBar.GaugeReset;
  119.   StatusBar.GaugeRestrictSub(60);
  120.   StatusBar.GaugeIn(2000);
  121.   StatusBar.SetString(stStatus,'adding');
  122.   FillChar(prp,Sizeof(TParProps),0);
  123.   prp.Attr := WPRichText1.Attr;
  124.   WPRichText1.Clear;
  125.   for i:=0 to 2000 do
  126.   begin
  127.      prp.Attr.Color := i mod 15;
  128.      prp.Text := 'Line ' + IntToStr(i);
  129.      WPRichText1.FastAddText(prp);
  130.      StatusBar.GaugeInc(i);
  131.   end;
  132.   StatusBar.SetString(stStatus,'format');
  133.   WPRichText1.Refresh;
  134.   StatusBar.SetString(stStatus,' ');
  135.   StatusBar.GaugeOut;
  136.   StatusBar.GaugeReset;
  137. end;
  138.  
  139. procedure TForm1.Table1Click(Sender: TObject);
  140. var
  141.   prp : TParProps;
  142.   Aprp : array[0..5] of TParProps;  { declared in unit WPtxtDef }
  143.   i   : Integer;
  144.   j,a   : Integer;
  145. begin
  146.   FillChar(Aprp[0],Sizeof(TParProps)*6,0);
  147.   for i:=0 to 5 do
  148.   begin
  149.     Aprp[i].Attr := WPRichText1.Attr;
  150.     Aprp[i].BorderType.LineType := [blEnabled,blBox];
  151.     Aprp[i].text := 'Cell ' + IntToStr(i);
  152.   end;
  153.  
  154.   FillChar(prp,Sizeof(TParProps),0);
  155.   prp.Attr := WPRichText1.Attr;
  156.   j := 0;
  157.  
  158.   WPRichText1.Clear;
  159.   try
  160.     for a:=1 to 10 do
  161.     begin
  162.        StatusBar.GaugeValue := a*10;
  163.        prp.Attr.Height := 20;
  164.        prp.NewPage := TRUE;
  165.  
  166.        prp.Text := 'And now the data from '+IntToStr(j)+' to '+IntToStr(j+100);
  167.        prp.NewPage := TRUE;
  168.        WPRichText1.FastAddText(prp);
  169.        prp.NewPage := FALSE;
  170.        prp.Text := '';
  171.        WPRichText1.FastAddText(prp);
  172.        for i:=1 to 50 do
  173.        begin
  174.         Aprp[5].Attr.tag := j;
  175.  
  176.         Aprp[0].Attr.Color := i mod 15;
  177.         Aprp[0].Text := 'Row ' + IntToStr(j);
  178.         WPRichText1.FastAddTable(6,@(Aprp[0]));
  179.         inc(j);
  180.        end;
  181.        prp.Text := '';
  182.        WPRichText1.FastAddText(prp);
  183.     end;
  184.   finally
  185.   StatusBar.GaugeValue := 0;
  186.   WPRichText1.Refresh;
  187.   end;
  188. end;
  189.  
  190. procedure TForm1.AddGraphicClick(Sender: TObject);
  191. begin
  192.   If not PicLoaded then
  193.   begin
  194.      if OpenDialog1.Execute then
  195.      begin  Image1.Picture.LoadFromFile(OpenDialog1.FileName);
  196.             PicLoaded := TRUE;
  197.             AddGraphic.Caption := 'Add Graphic';
  198.             Label1.Caption := 'Click to change';
  199.      end;
  200.   end
  201.   else  { This adds an new descriptor of the graphic into the text.
  202.           It don't copies the data!
  203.           You will get an GPF if you destroy or change
  204.           the source graphic without calling PicExchangeObj    
  205.         }       
  206.   WPRichText1.PicTagInsert(Image1.Picture.Graphic,ObjTag,twWidthDefault,twHeightDefault);
  207.   WPRichText1.PicClickEvent(ObjTag,0,OnImageClick); 
  208. end;
  209.  
  210. { This procedure will be executed when the user
  211.   clicks on the Image in the text }
  212. procedure TForm1.OnImageClick(var Sender: TObject;
  213.            x,y                 : Integer;  { Mouse position }
  214.            Tag, AutomaticTag   : Word;     { id in the text }
  215.            var w_twips,h_twips : Longint;  { size of box    }
  216.            var changed : Boolean);
  217. begin
  218.   PicSize.Xpt := w_twips div 20;
  219.   PicSize.Ypt := h_twips div 20;
  220.   PicSize.ShowModal;
  221.   w_twips := PicSize.Xpt * 20;
  222.   h_twips := PicSize.Ypt * 20;
  223. end;             
  224.  
  225. { Load an new graphic. exchange the object }
  226. procedure TForm1.Image1Click(Sender: TObject);
  227. begin
  228.      if OpenDialog1.Execute then
  229.      begin  Image1.Picture.LoadFromFile(OpenDialog1.FileName);
  230.             PicLoaded := TRUE;
  231.             AddGraphic.Caption := 'Add Graphic';
  232.             if WPRichText1.PicExchangeObj(ObjTag,0,Image1.Picture.Graphic,twWidthDefault,twHeightDefault)
  233.             then WPRichText1.PicRefresh;
  234.      end;
  235. end;
  236.  
  237. end.
  238.